VBA Word Extract and Reverse Blocks of paragraphs in Word document

Extract and Reverse "Prompted" Blocks in Word using VBA Macro

🧩 What This Macro Does

This VBA macro is designed for Microsoft Word documents that contain multiple occurrences of a keyword such as "Prompted". It automatically:

1. Searches from bottom to top of the document.

2. Each time it finds a line containing the word "Prompted", it:

   • Selects from that line to the end of the document,

   • Cuts the block,

   • Pastes it at the end of a new document.

3. This process continues until no more "Prompted" entries are found.

4. The result is a new Word document with all such blocks extracted in reversed order (i.e., last occurrence first).

5. The new document is saved:

   • In the same folder as the source file,

   • With a timestamped filename like:
     OriginalName_reversed_20250806_162530.docx

6. Finally, the original document is closed without saving any changes, keeping your source document untouched.

---

⚙️ Use Case Examples

• Reorganizing structured logs or notes in reverse or Gemini Chats copied in MS-Word

• Extracting repeated section-based content like surveys or prompted responses.

• Working with very large documents (e.g., 1000+ pages) efficiently.

---

🚀 Code

Sub ExtractPromptedBlocks_TrueReverse_SaveTimestamped_CloseOriginal()

    Dim docSource As Document
    Dim docTarget As Document
    Dim rngSearch As Range
    Dim rngCut As Range
    Dim findText As String
    Dim sourcePath As String
    Dim sourceName As String
    Dim savePath As String
    Dim timestamp As String

    ' Reference the active (source) document
    Set docSource = ActiveDocument
    Set docTarget = Documents.Add

    findText = "Prompted"

    ' Start from the end of the document
    Set rngSearch = docSource.Content
    rngSearch.Collapse Direction:=wdCollapseEnd

    ' Loop to cut "Prompted" blocks from bottom to top
    Do
        rngSearch.Find.ClearFormatting
        With rngSearch.Find
            .Text = findText
            .Forward = False
            .MatchCase = False
            .Wrap = wdFindStop
        End With

        If rngSearch.Find.Execute Then
            Set rngCut = docSource.Range(rngSearch.Paragraphs(1).Range.Start, docSource.Content.End)
            rngCut.Cut

            With docTarget.Content
                .Collapse Direction:=wdCollapseEnd
                .Paste
                .InsertParagraphAfter
            End With

            Set rngSearch = docSource.Range(0, rngSearch.Paragraphs(1).Range.Start)
        Else
            Exit Do
        End If
    Loop

    ' Prepare timestamp for unique filename
    timestamp = Format(Now, "_reversed_yyyymmdd_HHmmss")
    
    ' Build full save path
    sourcePath = docSource.Path
    sourceName = Left(docSource.Name, InStrRev(docSource.Name, ".") - 1)
    savePath = sourcePath & Application.PathSeparator & sourceName & timestamp & ".docx"

    ' Save new document with timestamped name
    docTarget.SaveAs2 FileName:=savePath, FileFormat:=wdFormatXMLDocument

    ' Close original document WITHOUT saving
    docSource.Close SaveChanges:=wdDoNotSaveChanges

    MsgBox "Done! Reversed content saved as:" & vbCrLf & savePath, vbInformation

End Sub

---

🚀 Benefits

• Fully automated and repeatable

• Works even with massive documents

• Prevents accidental overwrites using timestamped filenames

• Non-destructive to the original document

---

🧠 To Use the Macro

1. Open the Word document.

2. Press Alt + F11 to open the VBA Editor.

3. Insert a new module and paste the macro code.

4. Run the macro using Alt + F8.

---

This macro saves hours of manual effort and ensures accurate, clean extraction of structured content in reverse order. Ideal for professionals working with large, templated Word documents.

---